home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / pcfig4th.arc / FILES.SCR < prev    next >
Text File  |  1985-04-23  |  20KB  |  35 lines
  1.                                                                                                                                                          -+-                                                                                                                         MS-DOS  File                                              -+                    +-                                               Interface                                                                                                                          -+-                                                                                                                                                                                                                                                                                                                                                                      Note: these screens must be loaded from a FORTH disk!                                                                         ( strings: ", ["] )                                                                                                             : "    ( accept text delimited by " to PAD with count )              34 WORD  PAD C/L BLANKS                                         HERE PAD HERE C@ 1+ CMOVE ;                                                                                                : (")  ( moves text in definition to PAD )                           PAD C/L BLANKS                                                  R PAD R C@ 1+ R> OVER + >R  CMOVE ;                                                                                        : ["   ( as ", but get text in definition, then to PAD at exec )     COMPILE (")                                                     34 WORD  HERE C@ 1+ ALLOT ;  IMMEDIATE                     -->                                                                                                                                                                                             ( error handling: ABORT" )                                                                                                      : (AB")  PAD COUNT TYPE SP! QUIT ;                                                                                              : ABORT"  ( f -- ;abort execution and type a message )                    ( if f is TRUE )                                           [COMPILE] IF [COMPILE] ["                                        COMPILE  (AB")                                                 [COMPILE] THEN ;  IMMEDIATE                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ( MS-DOS file interface: support words, FNAME )                                                                                 : @FCB 2+ ;      (  fd -- FCB ; advances fd to start of FCB)    : @FSIZE  16 + ; ( FCB -- FCB.SIZE ; returns addr of size field)                                                                : FNAME  ( addr mode -- afn ; parse word at PAD as a filename )          ( afn is true if filename is ambiguous )                        ( Mode determines defaults for MS-DOS function 29H)             ( Parsed file name, drive+11 bytes, is left at addr)       PAD 1+ SWAP (FNAME)         ( -- addr' afn )                    SWAP PAD 1+ - PAD C@ = 0=                                       HEX 4000 PAD !              ( mark PAD so the name )            DECIMAL                     ( can't be used accidentally  )     ABORT" ? Illegal filename" ;                                -->                                                                                                                             ·3└Ä╪Ä└Ä╨╝ⁿ┐╣@│░╨µα╘
  2. ╘
  3. ╘
  4. ╘
  5. Ç√v
  6. ░XΦ0Çδδ±è├µΓ║πW░êµαδ¬Σσ╨╚∞s°_Φ$£u╟ü╟■├Γ┐Ω@µα╘
  7. ΣΣ¿t·Σα├·3└Ä╪Ä└Ä╨╝ⁿ┐╣│░╨µα╘
  8. ╘
  9. ╘
  10. ╘
  11. Ç√v
  12. ░XΦ@Çδδ±è├┤<v,┤µΓè─ µΣ║πW░êµαδ¬Σσ╨╚∞s°_Φ$£u╖ü╟Ç■├Γ»Ω@µα╘
  13. ΣΣ¿t·Σα├NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN÷÷÷ⁿNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN⌡⌡⌡■'≈NNNNNNNNNNNNNNNNNNNNNN⌡⌡⌡√σσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσ°  @`Ç    ≡  └α @`Çá└α! #@ o'Ç)á+└-α/1 3≡ 5`7Ç9á;└=α?A C@E`GÇIáK└Mα Q S@U`WÇYá[└]α_a c@e`gÇiák└mαoq s@u`wÇyá{└}αü â@à`çÇëáï└ìαÅ    æ     ô@    ò`    ùÇ    Öá    ¢└    ¥α    ƒ
  14. í 
  15.  O
  16. Ñ`
  17. ºÇ
  18. ⌐á
  19. ½└
  20. ¡α
  21. » ▒  │@ ╡` ╖Ç  » ╗└ ╜α ┐ ┴  ├@ ┼` ╟Ç ╔á  ╧ ═α ╧╤ ╙@╒`╫Ç┘á█└▌α▀ß π@σ`τÇΘáδ└φα∩± ≤@⌡`≈Ç∙á√└²α !Aaü    í ┴ß ! Oaüí┴ß!!#A%a'ü)í+┴-ß/1!3A5a7ü9í     28
  22.  
  23. ;=U   BLK    current block, 0 if te°  @`Ç    ≡  └α @`Çá└α! #@ o'Ç)á+└-α/1 3≡ 5`7Ç9á;└=α?A C@E`GÇIáK└Mα Q S@U`WÇYá[└]α_a c@e`gÇiák└mαoq s@u`wÇyá{└}αü â@à`çÇëáï└ìαÅ    æ     ô@    ò`    ùÇ    Öá    ¢└    ¥α    ƒ
  24. í 
  25.  O
  26. Ñ`
  27. ºÇ
  28. ⌐á
  29. ½└
  30. ¡α
  31. » ▒  │@ ╡` ╖Ç  » ╗└ ╜α ┐ ┴  ├@ ┼` ╟Ç ╔á  ╧ ═α ╧╤ ╙@╒`╫Ç┘á█└▌α▀ß π@σ`τÇΘáδ└φα∩± ≤@⌡`≈Ç∙á√└²α !Aaü    í ┴ß ! Oaüí┴ß!!#A%a'ü)í+┴-ß/1!3A5a7ü9í     28
  32.  
  33. ;=U   BLK    current block, 0 if teREADME     ,EFORTH   COMk
  34. 
  35. 154TH     COM≡%─PCFORTH COM⌠ú4╥4ASM     SCR┴≤O¿FUTIL   SCR╘    ú,UTIL    SCROÜ⌠╣$SCREENEDSCR╪╝╦êCASE    SCR≤FILES   SCRÅ≤Pσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσ-->                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             ( MS-DOS file interface: /CREATE /OPEN /CLOSE )                 : /CREATE  ( fd -- ; create and open fd )                            DUP ?SHUT  DUP ?WRITE                                           DUP @FCB 12 + FCBSIZE 12 - ERASE                                DUP @FCB (CREATE) ABORT" ? Can't create file"                   OPN TOGGLE ;                                               : /OPEN   ( fd -- ; open fd )                                        DUP ?SHUT                                                       DUP @FCB 12 + FCBSIZE 12 - ERASE                                DUP @FCB (OPEN) ABORT" ? File doesn't exist"                    OPN TOGGLE ;                                               : /CLOSE  ( fd -- ; close fd )                                       DUP @FCB (CLOSE)                                                ABORT" ? Can't close file, did you change disks?"               DUP @ -1 OPN - AND SWAP ! ;   -->                                                                                          ( MS-DOS file interface: /READ /WRITE )                                                                                         : /READ   ( fd addr n -- f ; READ n bytes from file fd to addr )     ROT DUP ?READ  DUP ?OPEN  DUP ?CHAR                             SWAP OVER ( addr fd n fd ) /SETSIZE                             @FCB SWAP (READ) ;                                                                                                         : /WRITE  ( addr n fd -- f ; WRITE n bytes from addr to fd )         DUP ?WRITE   DUP ?OPEN   DUP ?CHAR                              SWAP OVER /SETSIZE                                              @FCB SWAP (WRITE) ;                                        -->                                                             ( NOTE: n should not be varied between reads/writes ! )         ( The file pointer maintained by MSDOS is in terms of the )     ( record size being used, and changing the record size without) ( adjusting the pointer causes problems... )                    ( MS-DOS file interface: /GETC /PUTC )                          0 VARIABLE [C]                                                                                                                  : /GETC  ( fd -- c ; get char c from file fd )                       [C] 1 /READ IF 0 ELSE [C] @ THEN ;                                                                                         : /PUTC   ( c fd -- f ; write c to fd, f is TRUE on error )          SWAP [C] ! [C] 1 ROT /WRITE ;                                                                                              -->                                                                                                                                                                                                                                                                                                                                                                                                                                                             ( MS-DOS file interface: /BLKS )                                : /BLKS   ( fd -- n ; leaves no. B/BUF sized blocks in file. )            ( ABORTS if <filesize>/<B/BUF> is not an integer )         DUP ?OPEN                                                       DUP @FCB @FSIZE 2@ SWAP B/BUF M/ SWAP                           IF ( rem<>0 ) DROP /CLOSE ( close the file )                       ABORT" ? File isn't a screen file"                           ELSE SWAP DROP THEN ;                                      -->                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             ( MS-DOS file interface: SCREENS, /BLOCK-READ, WRITE )                                                                          RD WRT + SCRNS +    FILE  SCREENS ( fd for screens )                                                                            ( The following functions do no error checking because BLOCK )  ( becomes really  fouled up if it ABORTS  before finishing ! )                                                                  : /BLOCK-READ   ( addr blk -- ; read BLK from SCREENS )              RECORD !  DTA !                                                 SCREENS @FCB 1 (FBLKRD) DISK-ERROR ! ;                                                                                     : /BLOCK-WRITE  ( addr blk -- ; write BLK to SCREENS )               RECORD !  DTA !                                                 SCREENS @FCB 1 (FBLKWRT) DISK-ERROR ! ;                    -->                                                                                                                             ( MS-DOS file utilities: FCB display primitives )                                                                               : .DRIVE  ( addr -- ; print addr as drive A-Z )                      C@ 64 + EMIT 58 EMIT ;                                     : .FNAME  ( addr -- ; print filename at addr )                       DUP 8 TYPE 46 EMIT 8 + 3 TYPE SPACE ;                      : .FSIZE  ( addr -- ; print size )                                   2@ SWAP 10 D.R 2 SPACES ;                                                                                                  : 2DIGS 0 <# # # #> TYPE ;                                      : .MO   @ 480 AND 32 / 2DIGS 45 EMIT ;                          : .DAY  @ 31 AND 2DIGS 45 EMIT ;                                : .YR   1+ C@ 2 / 1980 + 0 <# # # # # #> TYPE 2 SPACES ;                                                                        -->                                                                                                                             ( MS-DOS file utilities: fd display /? )                        : .DATE  ( addr -- ; print date stamp )                             DUP .MO DUP .DAY .YR ;                                                                                                      : .HR   1+ C@ 248 AND 8 / 2 .R 58 EMIT ;                        : .MIN  @ 2016 AND 32 / 2DIGS 2 SPACES ;                        : .TIME DUP .HR .MIN ; ( addr -- ;print time stamp )            : /?  ( fd -- ; print status of file ) CR                            DUP @FCB DUP    .DRIVE DUP 1+ .FNAME >R                         DUP @ RD AND    IF 114 ELSE 45 THEN EMIT SPACE                  DUP @ WRT AND   IF 119 ELSE 45 THEN EMIT SPACE                  DUP @ SCRNS AND IF 115 ELSE 99 THEN EMIT SPACE                      @ OPN AND   IF R 16 + .FSIZE  R 20 + .DATE                  R> 22 + .TIME ELSE R> DROP THEN 2 SPACES ;                 -->                                                                                                                             ( MS-DOS file utilities: DIR )                                                                                                  : .DIR   ( addr -- ; print directory entry at addr )                 DUP >R .DRIVE R 1+ .FNAME R 29 + .FSIZE                              R 25 + .DATE R> 23 + .TIME SPACE ;                    -->                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             ( MS-DOS file interface: -SET, EOF )                            : -SET  ( addr blk -- ;inform user about disk state )                1 DISK-ERROR ! ( force BLOCK to abort )                         CR ." Specify disk access mode: "                               CR ." use SWITCH or USING" 34 EMIT 46 EMIT                      CR ;                                                                                                                       : EOF   ( -- ;quit using screen file, but don't use FORTH disk)      FLUSH SCREENS DUP ?OPEN DUP /BLKS  ( check # blocks )           SWAP /CLOSE IF ( # blocks >0 )                                    SCREENS @FCB PAD ?FIRST ABORT" File not in directory!"          PAD .DIR  ( show the directory entry )                        ELSE                                                              SCREENS @FCB ."  Erasing empty file..." FDEL                    IF ." couldn't erase " THEN                                   THEN  ' -SET CFA DUP @BLKRD ! @BLKWRT ! ; -->              ( MS-DOS file interface: SWITCH )                                                                                               : SWITCH   ( -- ;switch to FORTH disk )                              SCREENS @ OPN AND IF ( open ) EOF ( close SCREENS ) THEN        ' BLKRD CFA @BLKRD !  ' BLKWRT CFA @BLKWRT !                 CR CR ." WARNING: Replace MS-DOS disks with FORTH disks  " ;                                                                  : BYE  ( -- ;leave FORTH, make sure SCREENS are closed )             SCREENS @ OPN AND IF ( open ) EOF ( close SCREENS ) THEN        BYE ;                                                                                                                      : A:   ( -- ;select drive A as the default drive )                   0 DISK DROP ;                                                                                                              : B:   ( -- ;select drive B as the default drive )                   1 DISK DROP ; -->                                          ( MS-DOS file interface: USING" )                                                                                               : USING"   ( --;set up to use screen file. )                               ( usage is USING" filename" )                            SCREENS ?SHUT   ( only one file at a time! )                    [" .SCR" SCREENS @FCB 0 FNAME DROP ( set default = .SCR )       SCREENS @FCB "  ( get filename from terminal )                  DF-EXT FNAME    ( assign name to SCREENS using default ext )    ABORT" no */? allowed"                                          SCREENS @FCB (OPEN)              ( try to open it... )          IF ( non-existent ) SCREENS /CREATE                             ELSE SCREENS OPN TOGGLE THEN    ( set open attribute )          SCREENS /BLKS    ( check record size, leave # blocks )          0 WARNING !      ( probably can't find error mesages )          0 SCREENS /SETREC   ( initialize random record field )          B/BUF SCREENS /SETSIZE      ( transfer whole buffers ) -->  ( MS-DOS file interface: USING", cont. EXTEND )                     -DUP IF ( non-empty file )                                        ." last block in " SCREENS @FCB DUP .DRIVE                      1+ DUP 8 -TRAILING TYPE            ( print file name )          46 EMIT 8 + 3 -TRAILING TYPE       ( print ext )                ."  is " 1- U. ( print filename and number of blocks )        ELSE ." empty file " THEN                                       ' /BLOCK-READ CFA @BLKRD !      ( read from file now )          ' /BLOCK-WRITE CFA @BLKWRT !    ( write to file now )           EMPTY-BUFFERS ;                 ( don't mix buffers )                                                                       : EXTEND  ( n -- ;allocate n additional blocks to SCREENS )          SCREENS ?OPEN ( must be using SCREENS )                         SCREENS /BLKS + 1- BUFFER  ( assign a buffer to last block)     UPDATE SAVE-BUFFERS DROP ; ( force it to disk )            -->                                                             ( MS-DOS file interface: LOAD" , INDEX" )                                                                                       : LOAD"  ( -- ;load a screen file, can't be nested )                 USING" ( get file name and open file )                          0 15 0 DO I OVER CR .LINE  ( list screen 0 : title screen )     LOOP DROP  CR                                                   1 LOAD  ( start loading at screen 1 )                           EOF  ( quit after LOAD ) ;                                 ;S